perm filename READX.F4[IRC,LCS] blob
sn#641774 filedate 1982-02-15 generic text, type T, neo UTF8
00100 SUBROUTINE READX(N)
00200 C READS IN TWO FILES FOR TRANSFORMATION
00300 IMPLICIT INTEGER (X-Z)
00400 DIMENSION RN(3)
00500 C RN WILL HOLD FILE NAMES
00600 COMMON /A/X1(800),Y1(800),Z1(800),K1
00700 COMMON /B/X2(800),Y2(800),Z2(800),K2
00800 COMMON /C/X3(800),Y3(800),Z3(800),K3
00900 1 FORMAT(' TYPE FILE NAME '$)
01000 2 FORMAT(A5)
01100 3 FORMAT(4I)
01200 WRITE(5,1)
01300 READ(5,2)RN(N)
01400 NUM=1
01500 REWIND NUM
01600 CALL IFILE(NUM,RN(N))
01700 GO TO (10,20),N
01800 C K1 AND K2 WILL HOLD TOTAL OF POINTS.
01900 10 K1=1
02000 100 READ(NUM,3,END=12)K,X1(K1),Y1(K1),Z1(K1)
02100 K1=K1+1
02200 GO TO 100
02250 12 K1=K1-1
02275 RETURN
02300 20 K2=1
02400 200 READ(NUM,3,END=11)K,X2(K2),Y2(K2),Z2(K2)
02500 K2=K2+1
02600 GO TO 200
02700 11 K2=K2-1
02750 END
02800
02900 SUBROUTINE REVERS
03000 C REVERSES A AND B DATA. B MUST BE GREATER
03100 COMMON /A/X1(800),Y1(800),Z1(800),K1
03200 COMMON /B/X2(800),Y2(800),Z2(800),K2
03300 COMMON /C/X3(800),Y3(800),Z3(800),K3
03400 DO 1 K=1,K1
03500 X3(K)=X1(K)
03600 Y3(K)=Y1(K)
03700 1 Z3(K)=Z1(K)
03800 K3=K1
03900 DO 27 K=1,K2
04000 X1(K)=X2(K)
04100 Y1(K)=Y2(K)
04200 27 Z1(K)=Z2(K)
04300 K1=K2
04400 DO 3 K=1,K3
04500 X2(K)=X3(K)
04600 Y2(K)=Y3(K)
04700 3 Z2(K)=Z3(K)
04800 K2=K3
04900 END
05000
05100 SUBROUTINE FINDO(J,JOUT)
05200 DIMENSION J(1)
05300 DO 1 K=2,JOUT
05400 1 IF(J(K).NE.0)GO TO 2
05500 2 JOUT=K-1
05600 C TOTAL POINTS IN OUTLINE
05700 END
05800
05900 SUBROUTINE OUTPUT
06000 IMPLICIT INTEGER (X-Z)
06300 COMMON /A/X1(800),Y1(800),Z1(800),K1
06400 COMMON /B/X2(800),Y2(800),Z2(800),K2
06500 COMMON /C/X3(800),Y3(800),Z3(800),K3
06600 1 FORMAT(' TYPE OUTPUT FILE NAME '$)
06700 2 FORMAT(A5)
06710 TYPE 1
06720 ACCEPT 2,NAM
06730 IF(NAM.NE.'DPY')GO TO 20
06800 3 FORMAT(3I4,I2,3X,3I4,I2,3X,3I4,I2,3X,3I4,I2)
06900 J=K3/4+1
07000 DO 4 K=1,J
07050 L=K+J
07075 M=K+J+J
07087 N=K+J+J+J
07100 TYPE 3,K,X3(K),Y3(K),Z3(K),L,X3(L),Y3(L),Z3(L),
07200 3 M,X3(M),Y3(M),Z3(M),N,X3(N),Y3(N),Z3(N)
07300 4 CONTINUE
07400 PAUSE
07410 20 CALL OFILE(1,NAM)
07420 K1=0
07430 DO 21 K=1,K3
07440 IF(Z3(K).NE.0)GO TO 28
07450 C LOOK FOR REDUNDANT POINTS
07460 J=X3(K)
07470 IF(J.EQ.X3(K+1).AND.J.EQ.X3(K+2))GO TO 21
07480 J=Y3(K)
07490 IF(J.EQ.Y3(K+1).AND.J.EQ.Y3(K+2))GO TO 21
07500 28 K1=K1+1
07510 X1(K1)=X3(K)
07520 Y1(K1)=Y3(K)
07530 Z1(K1)=Z3(K)
07540 21 CONTINUE
07550 22 FORMAT(3I4,I2)
07570 DO 25 K=1,340
07572 IF(K.LT.320)GO TO 25
07574 IF(Z1(K).NE.0)GO TO 200
07580 25 WRITE(1,22)K,X1(K),Y1(K),Z1(K)
07590 200 END FILE 1
07600 NAM=NAM+2
07610 C BE SURE TO USE 5-LETTER NAME ONLY.
07620 CALL OFILE(1,NAM)
07630 M=0
07632 N=K
07640 DO 23 K=N,K1
07650 M=M+1
07660 23 WRITE(1,22)M,X1(K),Y1(K),Z1(K)
07670 END FILE 1
07680 END